C----------------------------------------------------------------------------

C Module name: Phinter.

C Author: Toby Howard.

C Function: PHIGS textual interpreter.

C Internal function list: readstring, readinteger, readreal,
C readphigsenum, interpreter, popenphigs.

C External function list: ptk_phinter.

C Hashtables used: "structureid".

C Modification history: (Version), (Date), (Name), (Description).

C  1.0, May 1986, Toby Howard, First version.

C 1.1, Jan 1988, Manjula Patel, PHIGS+ additions.

C 1.2, 14th July 1988, Steve Larkin, Modified to use Vax PHIGS$
C and a pascal binding in 'pbind.pas'.
 
C 2.0, May 1991, Gareth Williams, Converted to C.

C 2.1, June 1991, Gareth Williams, Completed handling of all PHIGS functions.

C----------------------------------------------------------------------------
 
       SUBROUTINE ptkf_phinter(input, outputscript, informscript)
C /*
C ** \parambegin
C ** \param{INTEGER}{input}{file pointer for input script}{IN}
C ** \param{INTEGER}{output}{file pointer for output script}{OUT}
C ** \param{INTEGER}{inform}{file pointer for information such as results of
C ** inquiry calls.}{OUT}
C ** \paramend
C ** \blurb{This function reads a PHIGS script from a file or from standard
C ** input. If {\tt stdin} is passed as the input file pointer then
C ** phinter becomes interactive and prompts are given for function
C ** parameters. The other file pointers are used for writing an output 
C ** script and for writing data which
C ** results from inquiry calls and so on.}
C */
       INTEGER input, outputscript, informscript
       external ptk_phinter !$PRAGMA C(ptk_phinter)

       call ptk_phinter(%val(input), 
& %val(outputscript), %val(informscript))

       RETURN
       END

       SUBROUTINE ptkf_strphinter(wsid, echoarea, outputterminal, 
& informterminal)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{REAL}{echo area(4)}{echo area for string device}{IN}
C ** \param{INTEGER}{outputterminal}{terminal window identifier for writing
C ** output script to}{IN}
C ** \param{INTEGER}{informterminal}{terminal window identifier for writing
C ** information data}{IN}
C ** \paramend
C ** \blurb{This function redirects the input of phinter to the PHIGS string 
C ** device (number 1). Strphinter is always interactive and output is 
C ** directed
C ** to terminal windows instead of files so that it may be displayed in the
C ** PHIGS workstation window.}
C */
       INTEGER wsid
       REAL echoarea(4)
       INTEGER outputterminal, informterminal
       external ptk_strphinter !$PRAGMA C(ptk_strphinter)

       call ptk_strphinter(%val(wsid), echoarea, %val(outputterminal), 
& %val(informterminal))

       RETURN
       END

       LOGICAL FUNCTION ptkf_readphinterscript(scriptname, output, 
& inform)
C /*
C ** \parambegin
C ** \param{CHARACTER*(*)}{scriptname}{script filename}{IN}
C ** \param{INTEGER}{output}{output script file pointer}{OUT}
C ** \param{INTEGER}{inform}{information script file pointer}{OUT}
C ** \paramend
C ** \blurb{This function reads a PHIGS script from the file specified
C ** by {\tt scriptname}. The file is automatically opened and closed
C ** and the function returns TRUE if a PHIGS script has been successfully 
C ** read.}
C */
       CHARACTER*(*) scriptname
       INTEGER output, inform
       LOGICAL*1 ptk_readphinterscript, ans
       external ptk_readphinterscript 
& !$PRAGMA C(ptk_readphinterscript)

       ans = ptk_readphinterscript(scriptname, %val(output),
& %val(inform))
       if (ans .eq. 1) then
          ptkf_readphinterscript = .TRUE.
       else
          ptkf_readphinterscript = .FALSE.
       endif

       RETURN
       END

       SUBROUTINE ptkf_writestruct(fileptr, num, stids)
C /*
C ** \parambegin
C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
C ** \param{INTEGER}{num}{number of structures}{IN}
C ** \param{INTEGER}{stids(*)}{structure identifier list}{IN}
C ** \paramend
C ** \blurb{This function writes the contents of a list of structures 
C ** to a file. The structures are written in the PHIGS script format so that
C ** they may be read in again using {\tt ptk\_phinter}.}
C */
       INTEGER fileptr, num, stids(num)
       external ptkc_writestruct !$PRAGMA C(ptkc_writestruct)

       call ptkc_writestruct(%val(fileptr), %val(num), 
& stids)

       RETURN
       END

       SUBROUTINE ptkf_writestructnet(fileptr, num, stids)
C /*
C ** \parambegin
C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
C ** \param{INTEGER}{num}{number of structures}{IN}
C ** \param{INTEGER}{stids(*)}{structure network identifier list}{IN}
C ** \paramend
C ** \blurb{This function writes the contents of a list of structure networks 
C ** to a file. The structures are written in the PHIGS script format so that
C ** they may be read in again using {\tt ptk\_phinter}.}
C */
       INTEGER fileptr, num, stids(num)
       external ptkc_writestructnet !$PRAGMA C(ptkc_writestructnet)

       call ptkc_writestructnet(%val(fileptr), %val(num), 
& stids)

       RETURN
       END

       SUBROUTINE ptkf_writeallstruct(fileptr)
C /*
C ** \parambegin
C ** \param{INTEGER}{fileptr}{pointer to file}{OUT}
C ** \paramend
C ** \blurb{This function writes the contents of all the structures in the
C ** PHIGS CSS to a file. The structures are written in the PHIGS script 
C ** format so that they may be read in again using {\tt ptk\_phinter}.}
C */
       INTEGER fileptr
       external ptk_writeallstruct !$PRAGMA C(ptk_writeallstruct)

       call ptk_writeallstruct(%val(fileptr))

       RETURN
       END

       SUBROUTINE ptkf_readelem(ws, echoarea, eltype)
C /*
C ** \parambegin
C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
C ** \param{REAL}{echo area(4)}{echo area for string device}{IN}
C ** \param{INTEGER}{eltype}{element type to read in}{IN}
C ** \paramend
C ** \blurb{This function reads the contents of a PHIGS element from the 
C ** PHIGS string device (number 1). Prompts are given for the required data
C ** depending on the element type. An element with the input data is inserted
C ** into the currently open structure at the current editing position.}
C */
       INTEGER ws
       REAL echoarea(4)
       INTEGER eltype
       external ptk_readelem !$PRAGMA C(ptk_readelem)

       call ptk_readelem(%val(ws), echoarea, %val(eltype))

       RETURN
       END

       SUBROUTINE ptkf_callphinter()
** \blurb{This function provides an interface to phinter and its related
** functions. The available commands are as follows:
** \begin{description}
** \item[help]{output this list.}
** \item[interactive]{call phinter with stdin for input script.}
** \item[stringinput]{call phinter using string device for input 
** and terminal windows for output.}
** \item[read]{call phinter with a given input script.}
** \item[outputfile]{set output script filename.}
** \item[informfile]{set information filename.}
** \item[outputterm]{set output terminal window identifier.}
** \item[informterm]{set information terminal window identifier.}
** \item[writestruct]{write contents of structures to output file.}
** \item[writestruct]{write contents of structure networks
** to output file.}
** \item[writestruct]{write contents of all structures to
** output file.}
** \item[quit or exit]{leave callphinter.}
** \end{description}\ 
** }
*/
       external ptk_callphinter !$PRAGMA C(ptk_callphinter)

       call ptk_callphinter()

       RETURN
       END

       LOGICAL FUNCTION ptkf_elemcontent(stid, elemid, termid, error)
C /* 
C ** \parambegin
C ** \param{INTEGER}{stid}{structure identifier}{IN}
C ** \param{INTEGER}{elemid}{element number}{IN}
C ** \param{INTEGER}{termid}{terminal window identifier}{IN}
C ** \param{INTEGER}{error}{error code}{OUT}
C ** \paramend
C ** \blurb{This function writes the contents of an element in a 
C ** terminal window. If the element is an output primitive then
C ** it is inserted into the currently open structure at the current
C ** editing position and the function returns TRUE, otherwise FALSE.}
C */
       INTEGER stid, elemid, termid, error
       LOGICAL*1 ptk_elemcontent, ans
       external ptk_elemcontent !$PRAGMA C(ptk_elemcontent)

       ans = ptk_elemcontent(%val(stid), %val(elemid), %val(termid), 
& error)
       if (ans .eq. 1) then
          ptkf_elemcontent = .TRUE.
       else
          ptkf_elemcontent = .FALSE.
       endif

       RETURN
       END

C end of phin.f
